home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Mega Archive 1
/
Atari Mega Archive - Volume 1.iso
/
language
/
gfaxpert.lzh
/
GFAXPERT.LIB
/
GRAPH1.LST
< prev
next >
Wrap
File List
|
1986-10-19
|
7KB
|
308 lines
' ******************
' *** GRAPH1.LST ***
' ******************
'
DEFWRD "a-z"
'
> PROCEDURE click.point(txt$,VAR x,y)
' *** choose point (x,y) with mouse-click
' *** uses Procedure Message.on and Message.off
LOCAL x1,y1,x2,y2,k
DEFMOUSE 3
SHOWM
@message.on(txt$)
x1=MOUSEX
y1=MOUSEY
REPEAT
MOUSE x2,y2,k
UNTIL x2<>x1 OR y2<>y1
@message.off
REPEAT
UNTIL MOUSEK ! wait for click
x=MOUSEX
y=MOUSEY
HIDEM
DEFMOUSE 0
PAUSE 10 ! short pause for release of button
RETURN
' **********
'
> PROCEDURE rubber.line(x,y,VAR x2,y2)
' *** draw line from point (x,y) to position of mouse (x2,y2)
' *** confirm with mouse-click
' *** uses Procedure Message.on and Message.off
LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k
GRAPHMODE 3
@message.on("draw line (confirm with click)")
DEFMOUSE 3
SHOWM
mx1=MOUSEX
my1=MOUSEY
REPEAT
MOUSE mx2,my2,k
UNTIL mx2<>mx1 OR my2<>my1
@message.off
MOUSE x1,y1,k
REPEAT
LINE x,y,x1,y1
REPEAT
MOUSE x2,y2,k
UNTIL x2<>x1 OR y2<>y1 OR k>0
LINE x,y,x1,y1
x1=x2
y1=y2
UNTIL k>0
GRAPHMODE 1
LINE x,y,x2,y2
HIDEM
DEFMOUSE 0
PAUSE 10
RETURN
' **********
'
> PROCEDURE draw.line(VAR x1,y1,x2,y2)
' *** draw line
' *** uses Procedure Click.point and Rubber.line
@click.point("click on starting point of line",x1,y1)
@rubber.line(x1,y1,x2,y2)
RETURN
' **********
'
> PROCEDURE rubber.box(x,y,VAR width,heigth)
' *** draw rectangle (left upper corner already chosen)
' *** uses Procedure Message.on and Message.off
LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k
GRAPHMODE 3
@message.on("draw rectangle (confirm with click)")
mx1=MOUSEX
my1=MOUSEY
REPEAT
MOUSE mx2,my2,k
UNTIL mx2<>mx1 OR my2<>my1
@message.off
MOUSE x1,y1,k
REPEAT
BOX x,y,x1,y1
PLOT x,y
REPEAT
MOUSE x2,y2,k
UNTIL (x2<>x1 AND x2>x) OR (y2<>y1 AND y2>y) OR k>0
BOX x,y,x1,y1
PLOT x,y
x1=x2
y1=y2
UNTIL k>0
GRAPHMODE 1
BOX x,y,x2,y2
width=x2-x
height=y2-y
PAUSE 10
RETURN
' **********
'
> PROCEDURE draw.box(VAR x,y,width,height)
' *** draw rectangle
' *** uses Procedure Click.point and Rubber.box
LOCAL x1,y1,width,height
@click.point("click on left upper corner of rectangle",x,y)
@rubber.box(x,y,width,height)
RETURN
' **********
'
> PROCEDURE rubber.square(x,y,VAR width)
' *** draw square (left upper corner already chosen)
' *** uses Procedure Message.on and Message.off
LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k,side
GRAPHMODE 3
HIDEM
@message.on("draw square (confirm with click)")
mx1=MOUSEX
my1=MOUSEY
REPEAT
MOUSE mx2,my2,k
UNTIL mx2<>mx1 OR my2<>my1
@message.off
MOUSE x1,y1,k
REPEAT
IF (x1-x)>(y1-y)
side=x1-x
ELSE
side=y1-y
ENDIF
BOX x,y,x+side,y+side
PLOT x,y
REPEAT
MOUSE x2,y2,k
UNTIL (x2<>x1 AND x2>x) OR (y2<>y1 AND y2>y) OR k>0
BOX x,y,x+side,y+side
PLOT x,y
x1=x2
y1=y2
UNTIL k>0
GRAPHMODE 1
BOX x,y,x+side,y+side
width=side
PAUSE 10
RETURN
' **********
'
> PROCEDURE draw.square(VAR x,y,width)
' *** draw square
' *** uses Procedure Click.point and Rubber.square
@click.point("click on left upper corner of square",x,y)
@rubber.square(x,y,width)
RETURN
' **********
'
> PROCEDURE drag.box(width,height,VAR x,y)
' *** drag rectangle
' *** place rectangle after mouse-click
' *** uses Procedure Message.on and Message.off
LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k
GRAPHMODE 3
HIDEM
@message.on("drag rectangle (place with click)")
mx1=MOUSEX
my1=MOUSEY
REPEAT
MOUSE mx2,my2,k
UNTIL mx2<>mx1 OR my2<>my1
@message.off
MOUSE x1,y1,k
REPEAT
BOX x1,y1,x1+width,y1+height
PLOT x1,y1
REPEAT
MOUSE x2,y2,k
UNTIL x2<>x1 OR y2<>y1 OR k>0
BOX x1,y1,x1+width,y1+height
PLOT x1,y1
x1=x2
y1=y2
UNTIL k>0
GRAPHMODE 1
BOX x2,y2,x2+width,y2+height
x=x2
y=y2
PAUSE 10
RETURN
' **********
'
> PROCEDURE move.box(width,height,x1,y1,x2,y2)
' *** move rectangle from x1,y1 to x2,y2
LOCAL x,y
GRAPHMODE 3
IF x1<x2 AND y1<y2
@p1
ELSE
IF x1<x2 AND y1>=y2
@p2
ELSE
IF x1>=x2 AND y1<y2
@p3
ELSE
@p4
ENDIF
ENDIF
ENDIF
GRAPHMODE 1
BOX x2,y2,x2+width,y2+height
RETURN
' ***
> PROCEDURE p1
FOR x=x1 TO x2
BOX x,y1,x+width,y1+height
BOX x,y1,x+width,y1+height
NEXT x
FOR y=y1 TO y2
BOX x,y,x+width,y+height
BOX x,y,x+width,y+height
NEXT y
RETURN
' ***
> PROCEDURE p2
FOR x=x1 TO x2
BOX x,y1,x+width,y1+height
BOX x,y1,x+width,y1+height
NEXT x
FOR y=y1 DOWNTO y2
BOX x,y,x+width,y+height
BOX x,y,x+width,y+height
NEXT y
RETURN
' ***
> PROCEDURE p3
FOR x=x1 DOWNTO x2
BOX x,y1,x+width,y1+height
BOX x,y1,x+width,y1+height
NEXT x
FOR y=y1 TO y2
BOX x,y,x+width,y+height
BOX x,y,x+width,y+height
NEXT y
RETURN
' ***
> PROCEDURE p4
FOR x=x1 DOWNTO x2
BOX x,y1,x+width,y1+height
BOX x,y1,x+width,y1+height
NEXT x
FOR y=y1 DOWNTO y2
BOX x,y,x+width,y+height
BOX x,y,x+width,y+height
NEXT y
RETURN
' **********
'
> PROCEDURE grow.box(width,height,x,y,pause)
' *** draw 'growing' rectangle
' *** pause determines grow-speed
LOCAL x1,y1,l,step.x,step.y,n,delta.x,delta.y
GRAPHMODE 3
x1=x+width/2
y1=y+height/2
l=MIN(height/2,width/2)
step.x=(width/2)/l
step.y=(height/2)/l
FOR n=1 TO l
delta.x=n*step.x
delta.y=n*step.y
BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y
PLOT x1-delta.x,y1-delta.y
PAUSE pause
BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y
PLOT x1-delta.x,y1-delta.y
NEXT n
GRAPHMODE 1
BOX x,y,x+width,y+height
RETURN
' **********
'
> PROCEDURE shrink.box(width,height,x,y,pause)
' *** draw 'shrinking' rectangle
' *** pause determines shrink-speed
LOCAL x1,y1,l,step.x,step.y,n,delta.x,delta.y
GRAPHMODE 3
x1=x+width/2
y1=y+height/2
l=MIN(height/2,width/2)
step.x=(width/2)/l
step.y=(height/2)/l
BOX x,y,x+width,y+height
PLOT x,y
BOX x,y,x+width,y+height
PLOT x,y
FOR n=l DOWNTO 1
delta.x=n*step.x
delta.y=n*step.y
BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y
PLOT x1-delta.x,y1-delta.y
PAUSE pause
BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y
PLOT x1-delta.x,y1-delta.y
NEXT n
GRAPHMODE 1
RETURN
' **********
'